perm filename SHORT.F4[1,LCS] blob sn#554895 filedate 1981-01-05 generic text, type T, neo UTF8
00100	C**** TO SHORTEN FOR22.DAT FILES FROM MS *****
00200	        DIMENSION I(110)
00300	        DOUBLE PRECISION NAM2
00400	1       FORMAT(' TYPE INPUT NAME  '$)
00500	2       FORMAT(A5)
00600	23      FORMAT(A10)
00700	3       FORMAT(110A1)
00800	        TYPE 1
00900	        ACCEPT 2,NAM
01000	        IF(NAM.EQ.' ')NAM='FOR22'
01100	        CALL IFILE(21,NAM)
01200	4       FORMAT(' TYPE OUTPUT NAME  '$)
01300	        TYPE 4
01400	        ACCEPT 23,NAM2
01500	CC      CALL OFILE(1,NAM2)
01600	        CALL DEFINE(1,0,NONO,NAM2)
01700	5       READ(21,3,END=100)I
01800	        DO 6 K=110,1,-1
01900	6       IF(I(K).NE.' ')GO TO 7
02000	7       J=1
02100	8       J=J+1
02200	        IF(J.GT.K)GO TO 50
02300	13      N=I(J)
02400	        IF(N.NE.'.')GO TO 11
02500	        IF(I(J+1).NE.'0')GO TO 10
02600	        IF(I(J+2).NE.'0')GO TO 10
02700	        IF(I(J+3).NE.'0')GO TO 10
02800	        K=K-4
02900	        DO 12 M=J,K
03000	12      I(M)=I(M+4)
03100	        GO TO 13
03200	11      IF(N.NE.' ')GO TO 8
03300	10      IF(I(J+1).NE.' ')GO TO 8
03400	        K=K-1
03500	        DO 9 M=J,K
03600	9       I(M)=I(M+1)
03700	        GO TO 10
03800	50      WRITE(1,3)(I(M),M=1,K)
03900	        GO TO 5
04000	100     N='*'
04100	        WRITE(1,3)N
04200	        END